perm filename SCLOOP.FAI[SCR,LCS] blob
sn#299324 filedate 1976-09-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SCLOOP: 0
C00030 ENDMK
C⊗;
SCLOOP: 0
MOVE 12,J
SETZM M# ;1108 M=0
SETZM JC# ; JC=0
SKIPGE NWZ ; IF(NWZ)GO TO 1740
JRST S1740 ; NWZZ IS SET AT 3111 IN SORTR.
SETZ 2, ;K DO 740 K=1,NWZZ
S740: MOVE BNW(2) ;X IS AC0 X=BNW(K)
MOVE 1,0 ; IF(X-.0001.GT.BT)GO TO 2740
FSBR 1,[0.0001]
CAMLE 1,BT
JRST S2740
CAMLE BW ; IF(X.LE.BW)GO TO 2740
SKIPGE BW ; IF(BW)GO TO 2740
JRST S2740
MOVE 3,IT-1(12) ; IT(J)=IT(J)*10
IMULI 3,=10
MOVEM 3,IT-1(12)
GO600: AOJ 2, ; NW=K
MOVEM 2,NW
JRA 16,(16) ; GO TO 600
S2740: CAMGE [1000.0] ;2740 IF(X.LT.1000.)GO TO 740
JRST SX740
MOVN 1,J ;IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
IMULI 1,=10000
FLTR 1,1
FADR 1,
MOVE 3,CNT-1(12)
FSBR 3,[1.0]
CAME 1,3
JRST SX740
MOVE BT ; X=BT+PR
FADR PR
MOVEM 3,BX ; NW=K
; BX=CNT(J)+1.
MOVNI 1,3 ; IT(J)=-3
MOVEM 1,IT-1(12) ; GO TO 600
JRST GO600
SX740: AOJ 2, ;740 CONTINUE
CAMGE 2,NWZZ
JRST S740
SETZM IT-1(12) ; IT(J)=0
S1740: CAMG 12,NINS ;1740 IF(J.LE.NINS)GO TO 31
JRST S31
S7021: MOVN NINS ;7021 K=J-NINS
ADD 12
SKIPLE JC ; IF(JC.GT.0)K=JC
MOVE JC
MOVEM K#
S5740: MOVE PP1 ;5740 IF(PP1.LT.OP1)GO TO 1752
CAMGE OP1
JRST S1752
S5741: SKIPL MZ ;5741 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
JRST SX1
JSA 16,WRTR
JUMP JOUT
JUMP [1] ; 1 IS CODE FOR THIS OUTPUT
SX1: SKIPL MX ; IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
JRST SX2 ; IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
JSA 16,WRTR;IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
JUMP [1]
JUMP [1]
MOVN 2,[9900.0]
MOVEI 1,2
S17521: MOVEM 2,COPY(1) ; DO 17521 L=3,30
CAIE 1,=29
AOJA 1,S17521 ;17521 COPY(L)=-9900.
S1752: MOVE 2,K ; SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
ADD 2,NINS ;1752 BG(K+NINS)=19999.
MOVE [19999.0]
MOVEM BG-1(2)
MOVE 2,K ; OTH(K,1)=19999.
MOVEM OTH-1(2)
MOVN [99.0] ; IF(BW.EQ.-99)GO TO 9726
CAMN BW
JRST S9726
SKIPLE JC ; IF(JC.GT.0)GO TO 21
JRST S21
S31: MOVEI 1 ;31 KL=1
MOVEM KL#
SKIPN KB ; IF(KB.EQ.0)GO TO 2031
JRST S2031
MOVEI 2,1 ;L DO 1031 L=1,KB
; K=L
S1031: MOVE OTH-1(2) ; X=OTH(K,1)-1000000.
FSBR [1000000.0] ;X IS AC0
MOVE 1,0
FDVR 1,[100000.0] ; M=X/100000.
KIFIX 1,1
CAMN 1,12 ; IF(M.NE.J)GO TO 1031
SKIPE IQ-1(12) ; IF(IQ(J).NE.0)GO TO 1031
JRST SX1031 ;C M=INST
IMUL 1,[-=100000] ; IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
FLTR 1,1
FADR 1,0
FSBR 1,[1.0]
CAMN 1,CNT-1(12)
JRST S5740
SX1031: CAMGE 2,KB ;1031 CONTINUE
AOJA 2,S1031
MOVEM 2,K
CAMLE 12,NINS ; IF(J.GT.NINS)GO TO 500
JRST S500
Z2031: AOS CNT-1(12) ;2031 CNT(J)=CNT(J)+1
KIFIX 11,CNT-1(12) ; ICT=CNT(J) ICT IS AC11
; INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
MOVE 10,NP-1(12) ; NPA=NP(J)
MOVE P1-1(12) ; PP1=P1(J)
MOVEM PP1
MOVE DUR-1(12) ; IF(BT.GE.DUR(J))GO TO 5174
CAML BP
JRST S5174
SKIPN IQ-1(12) ; IF(IQ(J).EQ.0)GO TO 200
JRST S200
FLTR 2,IQ-1(12) ; P2=-IQ(J)/10000.
FDVR 2,[10000.0]
MOVNM 2,P2
SETZM IQ-1(12) ; IQ(J)=0
SETOM CNT-1(12) ; CNT(J)=-1
SETO 11, ; ICT=-1
; PRINTS REST AND CNT=-1 WHEN 1ST BG TIME IS >0
JRST S4203 ; GO TO 4203
; MK IS FLAG FOR RESTS
S200: SETO 13, ;200 MK=0 MK IS AC13
SKIPE BT ; IF(BT.NE.0)GO TO 577
JRST S577
CAIE 12,1 ; IF(J.EQ.1)GO TO 203
S577: SKIPN IPT-1(12) ;577 IF(IPT(J,1).EQ.0)GO TO 203
JRST S203
MOVE 2,IPT-1(12) ; KN=IPT(J,1)-1
SOJ 2,
JUMPG 2,S12033 ; IF(KN.GT.0)GO TO 12033
S12032: MOVNS 2 ;12032 KN=JPT(-KN)
MOVE 2,JPT-1(KN)
JUMPL 2,S12302 ; IF(KN)GO TO 12032
SOJ 2, ; KN=KN-1
; FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
; SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
S12033: KIFIX 14,V-1(2) ;12033 IJ=V(KN)
MOVM V-1(2) ; IF(ABS(V(KN)).EQ.4.)GO TO 1203
CAMN [4.0] ;C 'IABS' IS FOR -4 USED WITH 'ALL'
JRST S1203
MOVE [9900.0] ; Z=(BT+9900.+V(KN-2))/V(KN+2)
FADR BP ;C******* FEB 19,71
FADR V-3(2)
FDVR V+1(2) ;Z IS AC0
CAMLE [1.0] ; IF(Z.GT.1.)Z=1.
MOVE [1.0]
MOVN 2,V+2(2) ;-Y IS AC2 Y=V(KN+3)
FADR 2,V+3(2) ; X=(V(KN+4)-Y)*Z+Y
FMPR 2,0 ;C******* FEB 19,71
FADR 2,V+2(2) ;X IS AC2
SKIPA ; GO TO 204
S1203: MOVE 1,V+2(2) ;1203 X=V(KN+3)
S204: JSA 16,RAND ;204 Y=RAND(0.0,1.0)
JUMP [0.0]
JUMP [1.0]
CAMLE 2 ; IF(Y-X)MK=-1
SETOM MK
S203: MOVE [1.0] ;203 DF=1.
MOVEM DF ;C DF=DUTY FACTOR
MOVEI 13,2 ;L IS 13 DO 2155 L=2,NPA
S2155: SETZM ISUB ; ISUB=0
; WHY DOES ISUB APPEAR AT 14700/5?
SETZM IDF# ; IDF=0
MOVE 1,L ;C IDF IS DUTY FACTOR FLAG
SUBI 1,1 ; IJ=IPT(J,L)
IMULI 1,=27
ADD 1,J
MOVE 1,IPT-1(1) ; AC1 IS IJ
JUMPGE 1,IJJ ;12031 IF(IJ)IJ=JPT(-IJ)
MOVNS 1
MOVE 1,JPT-1(1)
JUMPL 1,.-2 ; IF(IJ)GO TO 12031
; FOLLOWS UP ON POINTERS TO POINTERS!
MOVE [1.0] ; PM=1.
CAILE 1,1 ; IF(IJ.GT.1)GO TO 2157
JRST S2157
SETZM P-1(13) ; P(L)=0
JRST S21551 ; GO TO 21551
S2157: MOVE 12,1 ;LN IS 12 2157 LN=IJ+2
ADDI 12,2
MOVM 2,V(1) ; NM=ABS(V(IJ-1))+LN-4
KIFIX 11,2
ADD 11,12
SUBI 11,4 ;NM IS 11
KIFIX 10,V-1(1) ;NL IS 10 NL=V(IJ)
CAMLE 10,[-=100] ; IF(NL.GT.-100)GO TO 272
JRST S272
CAMLE 10,[-=200] ; IF(NL.GT.-200)GO TO 372
JRST S372
SETOM ISUB ; ISUB=-1
ADDI 10,=200 ; NL=NL+200
S372: CAMLE 10,[-=100] ;C FOR SUBROUTINE FLAG
JRST S272 ;372 IF(NL.GT.-100)GO TO 272
SETOM IDF ; IDF=-1
ADDI 10,=100 ; NL=NL+100
S272: MOVE 7,V(1) ;VIJ2 IS 7 C DEC.6,72 FINDS DUTY FACTOR PARAM
→→→→→→→ MOVE 2,10 ;272 VIJ2=V(IJ+1)
IDIV 2,[-=11] ;KN IS 2
JUMPE 2,S1100 ; KN=NL/(-11)
**************** IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(VIJ2.EQ.1.)GO TO 1200
ML=3
1900 KA=1
VX1=0
DO 1156 K=LN,NM,ML
VX(KA+1)=V(K)+VX(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VX(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=V(LN)
IF(RA.EQ.10000.)GO TO 5174
C FOR "FINE" IN RLIST
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.NE.-1)PM=2.
C IF 2 THEN PRINTS A5
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 IF(NL.LT.-12)GO TO 6100
601 X=P2
C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
CALL SUBR
CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 21552
PP2=P2
PR=P2
GO TO 21552
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
6100 IF(NL.EQ.-19)GO TO 6101
C NEXT IS FOR QUAD ROUTINES
CALL QUAD(NL)
GO TO 21552
6101 COFF1(J)=V(LN)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
COFF2(J)=V(LN+1)
GO TO 2155
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.VIJ2)KL=1
IF(NL.EQ.-46)GO TO 677
IF(NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
677 LN=KL+IJ+1
KL=KL+1
IF(KL.GT.VIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=V(IJ+KL+1)
C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
C************************
IF(KN.NE.3)GO TO 1155
C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
IF(PAR.EQ.10000.)GO TO 5174
PM=2.
IF(PAR.GT.100.)GO TO 777
IF(PAR.GE.1.)GO TO 877
777 PM=3.
877 IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56)GO TO 977
IF(NL.NE.-58)GO TO 771
977 PM=2.
771 Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.7.)W=V(IJ+4)
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.7.)GO TO 1600
GO TO 1155
C************** JUNE 1,71
C FOR "MOVX"
C******** FEB/73
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
16002 PAR=RMOVX(W,Y,Z)
C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C THIS NEEDS WORK!
IF(X.NE.7.)GO TO 1155
W=V(IJ+5)
Y=V(IJ+3)
X=RMOVX(W,Y,Z)
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
C1600 PAR=(V(IJ+4)-Y)*Z+Y
1600 W=V(IJ+3)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(V(IJ+5)-W)*Z+W
C************ JUNE 1,71
16003 PAR=RAND(PAR,X)
GO TO 1155
67 LN=IJ+3
NM=LN+VIJ2-1
ML=1
GO TO 1900
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
IF(L.NE.2)GO TO 772
IF(K.EQ.2)P2=PX2
C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
772 PM=PL(K)
GO TO 21551
C 9999.nn REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
GO TO 5155
68 KL=NCNT(J,L)
IF(KL.EQ.0)GO TO 774
IF(KL.NE.10000)GO TO 773
774 KL=VIJ2
773 PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).EQ.10000.)DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
GO TO 5155
C ******* JAN 20 *************
1155 IF(PAR.EQ.10000.)GO TO 5174
C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
IF(PAR.LE.9999.)GO TO 5155
IF(PAR.GE.9999.4)GO TO 5155
IF(PM.EQ.1.)GO TO 4155
C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
5155 P(L)=PAR
21551 PL(L)=PM
IF(ISUB)GO TO 601
IF(L.EQ.2)GO TO 4203
21552 IF(IDF.GE.0)GO TO 2155
DF=PAR
C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
IDF=0
2155 CONTINUE
9203 IF(KB.EQ.0)GO TO 1170
NL=KB
DO 2203 K=1,KB
X=OTH(NL,1)
IF(X.LT.100000.)GO TO 2203
L=X/100000.
Y=(X-L*100000.)/100.
IX=Y
JC=NL
IF(J.NE.L)GO TO 2203
IF(IX.EQ.ICT)GO TO 5203
2203 NL=NL-1
GO TO 1170
4203 X=COFF1(J)
IF(X.LE.BT)GO TG 6102
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
CC IF(P2.NE.PX2)GO TO 2155
C JUMP IF 'TEMPO' CHANGE
IF(BT+P2.GT.X-COFF2(J))P2=X-BT
6102 PR=P2
PX2=P2
C TO SAVE THE UNPROCESSED P2FOR 'P2 P2;' IN INPUT. 7/74
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1)GO TO 6203
IF(BT.LT.TBG+TDUR)GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
CALL SQYY(AC,T1,T2,TDUR)
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
C75 RD=1
KA=1
C75 RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
CALL ACCEL
8203 P2=RA*RD
7203 P2=P2*T4
X=ABS(P2*TF)
C P2 IS KEPT WITHOUT TF*
K=X+.5
Y=ROFF(J)
Y=Y+K-X
IF(Y.LT.1.)GO TO 7155
CCC IF(X)K=X-.5
CCC72031 ROFF(J)=ROFF(J)+K-X
CCC IF(ABS(ROFF(J)).LT.1.)GO TO 7155
CCC Y=1.
CCC IF(ROFF(J))Y=-Y
CCC K=K-Y
CCC ROFF(J)=ROFF(J)-Y
K=K-1
Y=Y-1.
C ROUND-OFF GAP WILL NOT EXCEED .001****.01 WITH NEW DAC!X?#@
C*********** FEB 17,71
7155 IF(P2)K=-K
PP2=K/100.
CCC7155 PP2=K/100.
ROFF(J)=Y
CROFF7155 PP2=K/1000.
C AVOIDS ROUND-OFF PROBLEMS **** TO 1/100 (1/76)
C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT)GO TO 1170
X=V(IPT(J,31)+2)/2.
IF(PP2.GE.0)GO TO 615
MK=-1
PP2=-PP2
615 Y=RAND(-X,X)
IF(Y.GE.PP2)Y=PP2/2.
PP2=PP2-RDEV(J)+Y
RDEV(J)=Y
C TOTAL RAND DEV. WON'T EXCEED P31
C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
K=PP2*100.+.5
CROFF K=PP2*1000.+.5
C****** CHECK THIS OUT 1/10/72 :::::::
61551 PP2=K/100.
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
6155 IF(ICT)GO TO 9203
GO TO 2155
5203 JD=Y*100-IX*100+.5
IF(JD.GT.0)GO TO 3203
M=0
P1(J)=PP1+PP2
GO TO 7021
3203 P(JD)=OTH(JC,2)
X=OTH(JC,3)
IF(X.NE.1.)X=3.
C 'EDITS' PRINT,NUM. OR 5 CHARS.
PL(JD)=X
C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
IF(JD.EQ.2)PP2=P2
C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
1170 IF(MK)GO TO 2022
IF(PP2)GO TO 2022
ZPAR=PP1
P1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
LK=INST(J)
2021 IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).LT.0)GO TO 2170
C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
IF(INONLY.GT.0)GO TO 1204
C*********** MAY 16,71 ↑↑↑
6021 IF(P(NPA).NE.COPY(NPA))GO TO 5021
IF(PL(NPA).GT.1)GO TO 5021
C******* MAY 25,71
C 'LIT' DATA WILL ALWAYS PRINT.
NPA=NPA-1
IF(NPA.GT.2)GO TO 6021
5021 DO 1304 K=3,NPA
1304 COPY(K)=P(K)
1204 IF(PL4.NE.1.)GO TO 2170
P4=P4*AMPFAC
L=0
INP(J)=P4
DO 1021 K=1,NINS
1021 IF(P1(K).GT.PP1)L=L+INP(K)
IF(L-IAMP-1)GO TO 2170
IAMP=L
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
C ********* MAY 17,71
PP1=PP1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF(MZ.NE.-1)GO TO 5170
IF(A.GE.PP1)GO TO 5170
IF(INONLY)WRITE(JOUT,902)
A=PP1+.05
5170 ML=10
IF(NPA.LT.10)ML=NPA
MLX=3
NL=2
IF(INVIS(J).EQ.0)GO TO 3170
LK=0
C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C NEXT CREATES FORMAT DATA IN IFM ARRAY.
31701 KL=3
GO TO 4170
3170 IF(J.EQ.INONLY)GO TO 775
IF(.NOT.INONLY)GO TO 2612
775 VX(1)=PP1
IF(DF.GT.0)GO TO 6170
VX2=PP2+DF
IF(VX2.LE.0)VX2=PP2/2
C NO NEG. TIME VALUES ALLOWED.
C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
GO TO 7170
6170 IF(DF.LT.100)GO TO 8170
C DF+100=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
VX2=DF-100.
IF(VX2.GT.PP2)VX2=PP2
GO TO 7170
8170 VX2=PP2*DF
7170 IFM3='F9.2,'
IFM4=IFM3
KL=5
IF(NPA.LT.3)GO TO 2121
4170 NL=2
DO 1121 K=MLX,ML
X=P(K)
L=PL(K)
IF(L-2)321,521,621
C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
321 IF(X.GE.0)GO TO 4211
IFM(KL)=IFCOM
NL=NL+1
KL=KL+1
4211 IFM(KL)='F7.2,'
IF(P(K).GT.999.99)IFM(KL)='F9.1,'
C CREATES 'F9.1' FOR BIGGER NUMS. (NO NEGS <-999.99)
421 VX(KL-NL)=X
GO TO 1121
521 IFM(KL)=IFM2
C CREATES '1XA5'
LN=X
VX(KL-NL)=SCAL(LN)
GO TO 42
621 IF(L.GT.3)GO TO 721
VX(KL-NL)=X
C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42 IFM(KL)=IFM2
GO TO 1121
721 LN=X
IFM(KL)=I1X
NL=NL+1
DO 821 M=1,LN-L+1
KL=KL+1
IOUT(KL-NL)=IV(L-1+M)
821 IFM(KL)=IA1
1121 KL=KL+1
C NO MORE THAN 80 ITEMS IN FORMAT.
2121 IF(KL.LE.80)GO TO 21211
21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
TYPE 21212
21211 DO 921 M=KL+1,80
921 IFM(M)=IBLA
IFM(KL)=')'
L=KL-NL-1
IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
IF(.NOT.MZ)GO TO 30210
IF(ML.GE.NPA)IFM(KL)='$)'
WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
30210 IF(ML.GE.NPA)GO TO 3021
MLX=ML+1
ML=ML+10
IF(ML.GT.NPA)ML=NPA
LK=IBLA
GO TO 31701
3021 IF(MX)WRITE(1,3616)INST(J),ICT
30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
2612 PP1=ZPAR
GO TO 21
8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
3616 FORMAT(';PRINT(P1);< ',A5,I4)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
INP(J)=0
P1(J)=PP1+PP2
C STORES NEXT P1 TIME FOR THIS INST.
IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(JOUT,902)
A=X+.05
121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
1 J,INST(J),ICT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CANT FOLLOW LAST REGULAR NOTE.
C (ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
NL=NINS+KB
DO 22 K=2,NL
22 IF(BG(J).GT.BG(K))J=K
IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
J=1
DO 5022 K=2,NINS
X=P1(J)
Y=P1(K)+.0001
C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
IF(BG(J).EQ.19999.)X=19999.
IF(BG(K).EQ.19999.)Y=19999.
5022 IF(X.GT.Y)J=K
C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)P1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
1175 FORMAT('+',A5,'=',F7.3,2X,$)
1109 FORMAT(' FINISH; < ',A5,'.DAT')
1110 FORMAT(' <',A5,2F8.2,2X,'******* REST <'I2,1XA5,I4)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I6,', AT TIME'
1,F8.3)
175 IF(MZ)WRITE(JOUT,1109),ISLAC
IF(MX.GE.0)GO TO 4175
WRITE(1,1109),ISLAC
END FILE 1
TYPE 60003
60003 FORMAT(' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
603 FORMAT(' TOTAL DURS: ',$)
CC FOR COLGATE ONLY***4175 CALL ENDSUB
C CLEARS CNTL O --- IF YOU HAVE HIT IT.
4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
WRITE(JOUT,603)
5175 DO 2175 K=1,NINS
X=P1(K)-OP1
IF(MZ)GO TO 6175
TYPE 1175,INST(K),X
GO TO 2175
6175 WRITE(JOUT,1175),INST(K),X
2175 CONTINUE
IF(JOUT.NE.22)GO TO 3175
END FILE 22
TYPE 7175
7175 FORMAT(' GOING TO LPT')
CALL PRINT
REWIND 22
K='FOR22'
CALL OFILE(22,K)
END FILE 22
3175 TYPE 1023,ISLAC,IXIN
CALL EXIT
END